home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbc_bas.exe / BARMENU.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-01-01  |  3.9 KB  |  127 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB AltKey (ASCIICode%, ScanCode%, Ky$)
  8.    DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  9.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  10.    DECLARE SUB ReColorArea (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
  11.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
  12.  
  13. SUB BarMenu (PickList$(), Row%, LCol%, RCol%, Attr%, HiAttr%, PromptSt$)
  14.  
  15.    L% = LBOUND(PickList$) - 1
  16.  
  17.    Choices% = 0
  18.    FOR tmp% = LBOUND(PickList$) TO UBOUND(PickList$)
  19.       IF LEN(PickList$(tmp%)) THEN
  20.          Choices% = Choices% + 1
  21.       ELSE
  22.          EXIT FOR
  23.       END IF
  24.    NEXT
  25.    IF Choices% = 0 THEN
  26.       Row% = 0
  27.       EXIT SUB
  28.    END IF
  29.  
  30.    DIM Posn%(1 TO Choices%)
  31.  
  32.    GetVidMode BIOSMode%, ScreenWidth%, Page%
  33.  
  34.    IF Row% = 0 THEN Row% = 1
  35.  
  36.    IF LCol% THEN
  37.       LeftCol% = LCol%
  38.    ELSE
  39.       LeftCol% = 1
  40.    END IF
  41.  
  42.    IF RCol% THEN
  43.       RightCol% = RCol%
  44.    ELSE
  45.       RightCol% = ScreenWidth%
  46.    END IF
  47.  
  48.    IF LEN(PromptSt$) THEN
  49.       Prompt$ = PromptSt$
  50.    ELSE
  51.       Prompt$ = " "
  52.    END IF
  53.  
  54.    Place% = 1
  55.  
  56.    BarPlace% = LeftCol% + LEN(Prompt$)
  57.    FOR tmp% = 1 TO Choices%
  58.       Posn%(tmp%) = BarPlace%
  59.       st$ = PickList$(L% + tmp%)
  60.       Bar$ = Bar$ + " " + st$ + " "
  61.       BarPlace% = BarPlace% + LEN(st$) + 2
  62.       ok% = 0
  63.       DO UNTIL ok% OR LEN(st$) = 0
  64.          ch$ = LEFT$(st$, 1)
  65.          ok% = (ch$ > " " AND ch$ < "a" OR ch$ > "z")
  66.          st$ = MID$(st$, 2)
  67.       LOOP
  68.       IF ok% THEN
  69.          KeyList$ = KeyList$ + ch$
  70.       ELSE
  71.          KeyList$ = KeyList$ + UCASE$(LEFT$(PickList$(L% + tmp%), 1))
  72.       END IF
  73.    NEXT
  74.    IF RightCol% < 1 THEN RightCol% = BarPlace%
  75.    IF RightCol% > ScreenWidth% THEN RightCol% = ScreenWidth%
  76.    Bar$ = LEFT$(Prompt$ + Bar$ + SPACE$(ScreenWidth%), RightCol% - LeftCol% + 1)
  77.  
  78.    XQPrint Bar$, Row%, LeftCol%, Attr%, Page%, Fast%
  79.    RightCol% = Posn%(Place%) + LEN(PickList$(L% + Place%)) + 1
  80.    ReColorArea Row%, Posn%(Place%), Row%, RightCol%, HiAttr%, Page%, Fast%
  81.  
  82.    DO
  83.       GetKey 0, AscCode%, ScanCode%, LeftB%, RightB%
  84.       IF AscCode% = 8 OR AscCode% = 0 AND (ScanCode% = 15 OR ScanCode% = 75) THEN
  85.          ' *** backspace, backtab, left arrow ***
  86.          IF Place% = 1 THEN
  87.             Place% = Choices%
  88.          ELSE
  89.             Place% = Place% - 1
  90.          END IF
  91.       ELSEIF AscCode% = 32 OR AscCode% = 9 OR AscCode% = 0 AND ScanCode% = 77 THEN
  92.          ' *** space, tab, right arrow ***
  93.          IF Place% = Choices% THEN
  94.             Place% = 1
  95.          ELSE
  96.             Place% = Place% + 1
  97.          END IF
  98.       ELSEIF AscCode% = 13 OR AscCode% = 27 THEN
  99.          ' *** <CR>, <ESC> ***
  100.          Done% = -1
  101.       ELSE
  102.          ' *** anything else... check to see if it's a menu selection ***
  103.          IF AscCode% > 32 THEN
  104.             ch$ = UCASE$(CHR$(AscCode%))
  105.          ELSE
  106.             AltKey AscCode%, ScanCode%, ch$
  107.          END IF
  108.          IF LEN(ch$) THEN
  109.             tmp% = INSTR(KeyList$, ch$)
  110.             IF tmp% THEN
  111.                Place% = tmp%
  112.                Done% = -1
  113.             END IF
  114.          END IF
  115.       END IF
  116.       XQPrint Bar$, Row%, LeftCol%, Attr%, Page%, Fast%
  117.       RightCol% = Posn%(Place%) + LEN(PickList$(L% + Place%)) + 1
  118.       ReColorArea Row%, Posn%(Place%), Row%, RightCol%, HiAttr%, Page%, Fast%
  119.    LOOP UNTIL Done%
  120.  
  121.    IF AscCode% = 27 THEN
  122.       Row% = 0
  123.    ELSE
  124.       Row% = Place%
  125.    END IF
  126. END SUB
  127.